(******************************************************************************)
(**)                        ОТДЕЛ ЦелОселок+;
(******************************************************************************
 * Приложение: "Dhrystone" (скорость целочисленных операций)
 * Автор:      Reinhold P. Weicker
 * Издано в:   CACM Т.27, № 10, 10/1984, с.1013
 *******************************************************************************
 * Испытание на скорость работы обычного приложения. В этом приложении:
 *   присваиваний           - 53%
 *   целочисленных действий - 32%
 *   вызовов задач          - 15%.
 * Ничего путного данное приложение не вычисляет.
 ******************************************************************************)
ИСПОЛЬЗУЕТ 
  ОС    ИЗ "...\Отделы\Обмен\",
  Вывод ИЗ "...\Отделы\Обмен\";

ПОСТ
  LOOPS  = 5000;
  Ident1 = 1;
  Ident2 = 2;
  Ident3 = 3;
  Ident4 = 4;
  Ident5 = 5;

ВИД Enumeration  =ЦЕЛ;
ВИД OneToThirty  =ЦЕЛ;
ВИД OneToFifty   =ЦЕЛ;
ВИД CapitalLetter=ЗНАК;
ВИД String30     =ЦЕПЬ[31];
ВИД Array1Dim    =РЯД 51 ИЗ ЦЕЛ;
ВИД Array2Dim    =РЯД 51,51 ИЗ ЦЕЛ;

RecordType = НАБОР
  PtrComp   :ЦЕЛ;
  Discr     :Enumeration;
  EnumComp  :Enumeration;
  IntComp   :OneToFifty;
  StringComp:String30
КОН;

ПЕР
  IntGlob   :ЦЕЛ;
  BoolGlob  :КЛЮЧ;
  Char1Glob :ЗНАК;
  Char2Glob :ЗНАК;
  Array1Glob:Array1Dim;
  Array2Glob:Array2Dim;
  MyRec     :РЯД 3 ИЗ RecordType;

ПОСТ
  PtrGlb    =1;
  PtrGlbNext=2;

ЗАДАЧА Proc7(IntParI1,IntParI2,IntParOut+:OneToFifty);
ПЕР
  IntLoc:OneToFifty;
УКАЗ
  IntLoc:=IntParI1+2;
  IntParOut:=IntParI2+IntLoc
КОН Proc7;

ЗАДАЧА Proc3(inRecIdx+:ЦЕЛ);
УКАЗ
  ЕСЛИ inRecIdx # 0 ТО
    inRecIdx:=MyRec[PtrGlb].PtrComp
  ИНАЧЕ
    IntGlob:=100
  КОН;
  Proc7(10,IntGlob,MyRec[PtrGlb].IntComp)
КОН Proc3;

ЗАДАЧА Func3(EnumParIn:Enumeration):КЛЮЧ;
ПЕР
  EnumLoc:Enumeration;
УКАЗ
  EnumLoc:=EnumParIn;
  ВОЗВРАТ EnumLoc=Ident3
КОН Func3;

ЗАДАЧА Proc6(EnumParIn,EnumParOut+:Enumeration);
УКАЗ
  EnumParOut:=EnumParIn;
  ЕСЛИ НЕ Func3(EnumParIn) ТО
    EnumParOut:=Ident4
  КОН;
  ВЫБРАТЬ EnumParIn ИЗ
  | Ident1:   EnumParOut:=Ident1
  | Ident2: ЕСЛИ IntGlob > 100 ТО
              EnumParOut:=Ident1
            ИНАЧЕ
              EnumParOut:=Ident4
            КОН
  | Ident3:   EnumParOut:=Ident2
  | Ident4: ;
  | Ident5:   EnumParOut:=Ident3
  КОН
КОН Proc6;

ЗАДАЧА Proc1(inIdx:ЦЕЛ);
ПЕР
  i:ЦЕЛ;
УКАЗ
  i:=MyRec[inIdx].PtrComp;
  MyRec[i]:=MyRec[PtrGlb];
  MyRec[inIdx].IntComp:=5;
  MyRec[i].IntComp:=MyRec[inIdx].IntComp;
  MyRec[i].PtrComp:=i;
  Proc3(MyRec[i].PtrComp);
  ЕСЛИ MyRec[i].Discr=Ident1 ТО
    MyRec[i].IntComp:=6;
    Proc6(MyRec[inIdx].EnumComp,MyRec[i].EnumComp);
    MyRec[i].PtrComp:=MyRec[PtrGlb].PtrComp;
    Proc7(MyRec[i].IntComp,10,MyRec[i].IntComp)
  ИНАЧЕ
    MyRec[inIdx]:=MyRec[i]
  КОН
КОН Proc1;

ЗАДАЧА Proc2(IntParIO+:OneToFifty);
ПЕР
  IntLoc :OneToFifty;
  EnumLoc:Enumeration;
УКАЗ
  IntLoc:=IntParIO+10;
  ПОВТОРЯТЬ
    ЕСЛИ Char1Glob='A' ТО
      IntLoc:=IntLoc-1;
      IntParIO:=IntLoc-IntGlob;
      EnumLoc:=Ident1
    КОН
  ДО EnumLoc=Ident1
КОН Proc2;

ЗАДАЧА Proc4;
ПЕР
  BoolLoc:КЛЮЧ;
УКАЗ
  BoolLoc:=(Char1Glob='A');
  BoolLoc:=(BoolLoc ИЛИ BoolGlob);
  Char2Glob:='B'
КОН Proc4;

ЗАДАЧА Proc5;
УКАЗ
  Char1Glob:='A';
  BoolGlob:=ОТКЛ
КОН Proc5;

ЗАДАЧА Proc8(Array1Par+:Array1Dim; Array2Par+:Array2Dim; IntParI1,IntParI2:OneToFifty);
ПЕР
  IntLoc  :OneToFifty;
  IntIndex:OneToFifty;
УКАЗ
  IntLoc:=IntParI1+5;
  Array1Par[IntLoc]:=IntParI2;
  Array1Par[IntLoc+1]:=Array1Par[IntLoc];
  Array1Par[IntLoc+30]:=IntLoc;
  ОТ IntIndex:=IntLoc ДО IntLoc+1 ВЫП
     Array2Par[IntLoc,IntIndex]:=IntLoc
  КОН;
  Array2Par[IntLoc+20,IntLoc]:=Array1Par[IntLoc];
  IntGlob:=5
КОН Proc8;

ЗАДАЧА Func1(CharPar1,CharPar2:CapitalLetter):Enumeration;
ПЕР
  CharLoc1,CharLoc2:CapitalLetter;
УКАЗ
  CharLoc1:=CharPar1;
  CharLoc2:=CharLoc1;
  ЕСЛИ CharLoc2 # CharPar2 ТО
    ВОЗВРАТ Ident1
  ИНАЧЕ
    ВОЗВРАТ Ident2
  КОН
КОН Func1;

ЗАДАЧА Func2(StrParI1+,StrParI2+:String30):КЛЮЧ;
ПЕР
  IntLoc :OneToThirty;
  CharLoc:CapitalLetter;
УКАЗ
  IntLoc:=2;
  ПОКА (IntLoc <= 2) ВЫП
    ЕСЛИ Func1(StrParI1[IntLoc],StrParI2[IntLoc+1])=Ident1 ТО
      CharLoc:='A';
      IntLoc:=IntLoc+1
    КОН
  КОН;
  ЕСЛИ (CharLoc >= 'W') И (CharLoc <= 'Z') ТО
    IntLoc:=7
  КОН;
  ЕСЛИ  CharLoc='X' ТО
    ВОЗВРАТ ВКЛ
  АЕСЛИ StrParI1 > StrParI2 ТО
    IntLoc:=IntLoc+7;
    ВОЗВРАТ ВКЛ
  ИНАЧЕ
    ВОЗВРАТ ОТКЛ
  КОН
КОН Func2;

ЗАДАЧА Proc0;
ПЕР
  IntLoc1   :OneToFifty;
  IntLoc2   :OneToFifty;
  IntLoc3   :OneToFifty;
  CharLoc   :ЗНАК;
  CharIndex :ЗНАК;
  EnumLoc   :Enumeration;
  String1Loc,
  String2Loc:String30;
  i,j       :ЦЕЛ;
УКАЗ
  MyRec[PtrGlb].PtrComp:=PtrGlbNext;
  MyRec[PtrGlb].Discr:=Ident1;
  MyRec[PtrGlb].EnumComp:=Ident3;
  MyRec[PtrGlb].IntComp:=40;
  MyRec[PtrGlb].StringComp:="DHRYSTONE PROGRAM, SOME STRING";
  String1Loc:="DHRYSTONE PROGRAM, 1'ST STRING";
  ОТ i:=1 ДО LOOPS ВЫП
    ОТ j:=1 ДО 1000 ВЫП
      Proc5;
      Proc4;
      IntLoc1:=2;
      IntLoc2:=3;
      String2Loc:="DHRYSTONE PROGRAM, 2'ND STRING";
      EnumLoc:=Ident2;
      BoolGlob:=НЕ Func2(String1Loc,String2Loc);
      ПОКА IntLoc1 < IntLoc2 ВЫП
        IntLoc3:=5*IntLoc1-IntLoc2;
        Proc7(IntLoc1,IntLoc2,IntLoc3);
        IntLoc1:=IntLoc1+1
      КОН;
      Proc8(Array1Glob,Array2Glob,IntLoc1,IntLoc3);
      Proc1(PtrGlb);
      CharIndex:='A';
      ПОКА CharIndex <= Char2Glob ВЫП
        ЕСЛИ EnumLoc=Func1(CharIndex,'C') ТО
          Proc6(Ident1,EnumLoc)
        КОН;
        CharIndex:=ВЗНАК(ВЦЕЛ(CharIndex)+1)
      КОН;
      IntLoc3:=IntLoc2*IntLoc1;
      IntLoc2:=IntLoc3 ДЕЛИТЬ IntLoc1;
      IntLoc2:=7*(IntLoc3-IntLoc2)-IntLoc1;
      Proc2(IntLoc1)
    КОН
  КОН
КОН Proc0;

ЗАДАЧА Голова;
ПЕР
  начВремя:ЦЕЛ;
УКАЗ
  Вывод.Цепь("Испытание на Dhrystone (скорость целочисленных операций)");
  начВремя:=ОС.Время();
  Proc0;
  Вывод.ЧВещ(" - %f с^",(ОС.Время()-начВремя)/1000,0,0,0)
КОН Голова;

УКАЗ
  Голова
КОН ЦелОселок.

▲ Вопросы, замечания и предложения высылайте на atimopheyev@yahoo.com или Издателю Глагола: